home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / GIMP 2.6.8 / gimp-2.6.8-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / spyrogimp.scm < prev    next >
Text File  |  2009-12-15  |  12KB  |  359 lines
  1. ;; spyrogimp.scm -*-scheme-*-
  2. ;; Draws Spirographs, Epitrochoids and Lissajous Curves.
  3. ;; More info at http://www.wisdom.weizmann.ac.il/~elad/spyrogimp/
  4. ;; Version 1.2
  5. ;;
  6. ;; Copyright (C) 2003 by Elad Shahar <elad@wisdom.weizmann.ac.il>
  7. ;;
  8. ;; This program is free software; you can redistribute it and/or
  9. ;; modify it under the terms of the GNU General Public License
  10. ;; as published by the Free Software Foundation; either version 2
  11. ;; of the License, or (at your option) any later version.
  12. ;;
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17. ;;
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with this program; if not, write to the Free Software
  20. ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23.  
  24.  
  25. ; This routine is invoked by a dialog.
  26. ; It is the main routine in this file.
  27. (define (script-fu-spyrogimp img drw
  28.                              type shape
  29.                              oteeth iteeth
  30.                              margin hole-ratio start-angle
  31.                              tool brush
  32.                              color-method color grad)
  33.  
  34.   ; Internal function to draw the spyro.
  35.   (define (script-fu-spyrogimp-internal img drw
  36.                x1 y1 x2 y2   ; Bounding box.
  37.                type          ; = 0 (Spirograph), 1 (Epitrochoid), 2(Lissajous) .
  38.                shape         ; = 0 (Circle), 1 (Frame), >2 (Polygons) .
  39.                oteeth iteeth ; Outer and inner teeth.
  40.                margin hole-ratio
  41.                start-angle   ; 0 <= start-angle < 360 .
  42.                tool          ; = 0 (Pencil), 1 (Brush), 2 (Airbrush) .
  43.                brush
  44.                color-method  ; = 0 (Single color), 1 (Grad. Loop Sawtooth),
  45.                              ;   2 (Grad. Loop triangle) .
  46.                color         ; Used when color-method = Single color .
  47.                grad          ; Gradient used in Gradient color methods.
  48.           )
  49.  
  50.  
  51.     ; This function returns a list of samples according to the gradient.
  52.     (define (get-gradient steps color-method grad)
  53.       (if (= color-method 1)
  54.           ; option 1
  55.           ; Just return the gradient
  56.           (gimp-gradient-get-uniform-samples grad (min steps 50) FALSE)
  57.  
  58.           ; option 2
  59.           ; The returned list is such that the gradient appears two times, once
  60.           ; in the normal order and once in reverse. This way there are no color
  61.           ; jumps if we go beyond the edge
  62.           (let* (
  63.                 ; Sample the gradient into array "gr".
  64.                 (gr (gimp-gradient-get-uniform-samples grad
  65.                                                        (/ (min steps 50) 2)
  66.                                                        FALSE))
  67.  
  68.                 (grn (car gr))  ; length of sample array.
  69.                 (gra (cadr gr)) ; array of color samples (R1,G1,B1,A1, R2,....)
  70.  
  71.                 ; Allocate array gra-new of size  (2 * grn) - 8,
  72.                 ; but since each 4 items is actually one (RGBA) tuple,
  73.                 ; it contains 2x - 2 entries.
  74.                 (grn-new (+ grn grn -8))
  75.                 (gra-new (cons-array grn-new 'double))
  76.  
  77.                 (gr-index 0)
  78.                 (gr-index2 0)
  79.                 )
  80.  
  81.             ; Copy original array gra to gra_new.
  82.             (while (< gr-index grn)
  83.                (aset gra-new gr-index (aref gra gr-index))
  84.                (set! gr-index (+ 1 gr-index))
  85.             )
  86.  
  87.             ; Copy second time, but in reverse
  88.             (set! gr-index2 (- gr-index 8))
  89.             (while (< gr-index grn-new)
  90.                (aset gra-new gr-index (aref gra gr-index2))
  91.                (set! gr-index (+ 1 gr-index))
  92.                (set! gr-index2 (+ 1 gr-index2))
  93.  
  94.                (if (= (fmod gr-index 4) 0)
  95.                  (set! gr-index2 (- gr-index2 8))
  96.                )
  97.             )
  98.  
  99.             ; Return list.
  100.             (list grn-new gra-new)
  101.           )
  102.       )
  103.     )
  104.  
  105.  
  106.     (let* (
  107.           (steps (+ 1 (lcm oteeth iteeth)))
  108.           (*points* (cons-array (* steps 2) 'double))
  109.  
  110.           (ot 0)                         ; current outer tooth
  111.           (cx 0)                         ; Current x,y
  112.           (cy 0)
  113.  
  114.           ; If its a polygon or frame, how many sides does it have.
  115.           (poly (if (= shape 1) 4   ; A frame has four sides.
  116.                                 (if (> shape 1) (+ shape 1) 0)))
  117.  
  118.           (2pi (* 2 *pi*))
  119.  
  120.           (drw-width (- x2 x1))
  121.           (drw-height (- y2 y1))
  122.           (half-width (/ drw-width 2))
  123.           (half-height (/ drw-height 2))
  124.           (midx (+ x1 half-width))
  125.           (midy (+ y1 half-height))
  126.  
  127.           (hole (* hole-ratio
  128.                    (- (/ (min drw-width drw-height) 2) margin)
  129.                 )
  130.           )
  131.           (irad (+ hole margin))
  132.  
  133.           (radx (- half-width irad))  ;
  134.           (rady (- half-height irad)) ;
  135.  
  136.           (gradt (get-gradient steps color-method grad))
  137.           (grada (cadr gradt)) ; Gradient array.
  138.           (gradn (car gradt))  ; Number of entries of gradients.
  139.  
  140.           ; Indexes
  141.           (grad-index 0)  ; for array: grada
  142.           (point-index 0) ; for array: *points*
  143.           (index 0)
  144.           )
  145.  
  146.       ; Do one step of the loop.
  147.       (define (calc-and-step!)
  148.         (let* (
  149.               (oangle (* 2pi (/ ot oteeth)) )
  150.               (shifted-oangle (+ oangle (* 2pi (/ start-angle 360))) )
  151.               (xfactor (cos shifted-oangle))
  152.               (yfactor (sin shifted-oangle))
  153.               (lenfactor 1)
  154.               (ofactor (/ (+ oteeth iteeth) iteeth))
  155.  
  156.               ; The direction of the factor changes according
  157.               ; to whether the type is a sypro or an epitcorhoid.
  158.               (mfactor (if (= type 0) (- ofactor) ofactor))
  159.               )
  160.  
  161.           ; If we are drawing a polygon then compute a contortion
  162.           ; factor "lenfactor" which deforms the standard circle.
  163.           (if (> poly 2)
  164.             (let* (
  165.                   (pi4 (/ *pi* poly))
  166.                   (pi2 (* pi4 2))
  167.  
  168.                   (oanglemodpi2 (fmod (+ oangle
  169.                                         (if (= 1 (fmod poly 2))
  170.                                            0 ;(/ pi4 2)
  171.                                            0
  172.                                         )
  173.                                       )
  174.                                       pi2))
  175.                   )
  176.  
  177.                   (set! lenfactor (/ ( if (= shape 1) 1 (cos pi4) )
  178.                                      (cos
  179.                                        (if (< oanglemodpi2 pi4)
  180.                                          oanglemodpi2
  181.                                          (- pi2 oanglemodpi2)
  182.                                        )
  183.                                      )
  184.                                   )
  185.                   )
  186.             )
  187.           )
  188.  
  189.           (if (= type 2)
  190.             (begin  ; Lissajous
  191.               (set! cx (+ midx
  192.                           (* half-width (cos shifted-oangle)) ))
  193.               (set! cy (+ midy
  194.                           (* half-height (cos (* mfactor oangle))) ))
  195.             )
  196.             (begin  ; Spyrograph or Epitrochoid
  197.              (set! cx (+ midx
  198.                          (* radx xfactor lenfactor)
  199.                          (* hole (cos (* mfactor oangle) ) ) ))
  200.              (set! cy (+ midy
  201.                          (* rady yfactor lenfactor)
  202.                          (* hole (sin (* mfactor oangle) ) ) ))
  203.             )
  204.           )
  205.  
  206.         ;; Advance teeth
  207.         (set! ot (+ ot 1))
  208.         )
  209.       )
  210.  
  211.  
  212.       ;; Draw all the points in *points* with appropriate tool.
  213.       (define (flush-points len)
  214.         (if (= tool 0)
  215.           (gimp-pencil drw len *points*)              ; Use pencil
  216.           (if (= tool 1)
  217.             (gimp-paintbrush-default drw len *points*); use paintbrush
  218.             (gimp-airbrush-default drw len *points*)  ; use airbrush
  219.           )
  220.         )
  221.  
  222.         ; Reset points array, but copy last point to first
  223.         ; position so it will connect the next time.
  224.         (aset *points* 0 (aref *points* (- point-index 2)))
  225.         (aset *points* 1 (aref *points* (- point-index 1)))
  226.         (set! point-index 2)
  227.       )
  228.  
  229.    ;;
  230.    ;; Execution starts here.
  231.    ;;
  232.  
  233.       (gimp-context-push)
  234.  
  235.       (gimp-image-undo-group-start img)
  236.  
  237.       ; Set new color, brush, opacity, paint mode.
  238.       (gimp-context-set-foreground color)
  239.       (gimp-context-set-brush (car brush))
  240.       (gimp-context-set-opacity (* 100 (car (cdr brush))))
  241.       (gimp-context-set-paint-mode (car (cdr (cdr (cdr brush)))))
  242.  
  243.       (gimp-progress-set-text _"Rendering Spyro")
  244.  
  245.       (while (< index steps)
  246.  
  247.           (calc-and-step!)
  248.  
  249.           (aset *points* point-index cx)
  250.           (aset *points* (+ point-index 1) cy)
  251.           (set! point-index (+ point-index 2))
  252.  
  253.           ; Change color and draw points if using gradient.
  254.           (if (< 0 color-method)  ; use gradient.
  255.              (if (< (/ (+ grad-index 4) gradn) (/ index steps))
  256.                (begin
  257.                 (gimp-context-set-foreground
  258.                   (list
  259.                     (* 255 (aref grada grad-index))
  260.                     (* 255 (aref grada (+ 1 grad-index)) )
  261.                     (* 255 (aref grada (+ 2 grad-index)) )
  262.                   )
  263.                 )
  264.                 (gimp-context-set-opacity (* 100 (aref grada (+ 3 grad-index) ) )  )
  265.                 (set! grad-index (+ 4 grad-index))
  266.  
  267.                 ; Draw points
  268.                 (flush-points point-index)
  269.                )
  270.              )
  271.           )
  272.  
  273.           (set! index (+ index 1))
  274.  
  275.       (if (= 0 (modulo index 16))
  276.           (gimp-progress-update (/ index steps))
  277.       )
  278.       )
  279.  
  280.       ; Draw remaining points.
  281.       (flush-points point-index)
  282.  
  283.       (gimp-progress-update 1.0)
  284.  
  285.       (gimp-image-undo-group-end img)
  286.       (gimp-displays-flush)
  287.  
  288.       (gimp-context-pop)
  289.     )
  290.   )
  291.  
  292.   (let* (
  293.         ; Get current selection to determine where to draw.
  294.         (bounds (cdr (gimp-selection-bounds img)))
  295.         (x1 (car bounds))
  296.         (y1 (cadr bounds))
  297.         (x2 (caddr bounds))
  298.         (y2 (car (cdddr bounds)))
  299.         )
  300.  
  301.     (set! oteeth (trunc (+ oteeth 0.5)))
  302.     (set! iteeth (trunc (+ iteeth 0.5)))
  303.  
  304.     (script-fu-spyrogimp-internal img drw
  305.              x1 y1 x2 y2
  306.              type shape
  307.              oteeth iteeth
  308.              margin hole-ratio start-angle
  309.              tool brush
  310.              color-method color grad)
  311.   )
  312. )
  313.  
  314.  
  315.  
  316. (script-fu-register "script-fu-spyrogimp"
  317.   _"_Spyrogimp..."
  318.   _"Add Spirographs, Epitrochoids, and Lissajous Curves to the current layer"
  319.   "Elad Shahar <elad@wisdom.weizmann.ac.il>"
  320.   "Elad Shahar"
  321.   "June 2003"
  322.   "RGB*, INDEXED*, GRAY*"
  323.   SF-IMAGE       "Image"         0
  324.   SF-DRAWABLE    "Drawable"      0
  325.  
  326.   SF-OPTION     _"Type"          '(_"Spyrograph"
  327.                                    _"Epitrochoid"
  328.                                    _"Lissajous")
  329.   SF-OPTION     _"Shape"         '(_"Circle"
  330.                                     _"Frame"
  331.                                    _"Triangle"
  332.                                    _"Square"
  333.                                    _"Pentagon"
  334.                                    _"Hexagon"
  335.                                    _"Polygon: 7 sides"
  336.                                    _"Polygon: 8 sides"
  337.                                    _"Polygon: 9 sides"
  338.                                    _"Polygon: 10 sides")
  339.   SF-ADJUSTMENT _"Outer teeth"   '(86 1 120 1 10 0 0)
  340.   SF-ADJUSTMENT _"Inner teeth"   '(70 1 120 1 10 0 0)
  341.   SF-ADJUSTMENT _"Margin (pixels)" '(0 -10000 10000 1 10 0 1)
  342.   SF-ADJUSTMENT _"Hole ratio"    '(0.4 0.0 1.0 0.01 0.1 2 0)
  343.   SF-ADJUSTMENT _"Start angle"   '(0 0 359 1 10 0 0)
  344.  
  345.   SF-OPTION     _"Tool"          '(_"Pencil"
  346.                                    _"Brush"
  347.                                    _"Airbrush")
  348.   SF-BRUSH      _"Brush"         '("Circle (01)" 1.0 -1 0)
  349.  
  350.   SF-OPTION     _"Color method"  '(_"Solid Color"
  351.                                    _"Gradient: Loop Sawtooth"
  352.                                    _"Gradient: Loop Triangle")
  353.   SF-COLOR      _"Color"          "black"
  354.   SF-GRADIENT   _"Gradient"       "Deep Sea"
  355. )
  356.  
  357. (script-fu-menu-register "script-fu-spyrogimp"
  358.                          "<Image>/Filters/Render")
  359.